PC Plus SuperCD (UK) 1997 May/PC Plus Super CD Issue 127 (May 1997).iso/delphi1/lesson4/tapecalc/calc4.pas

Pascal/Delphi Source File | 1996-07-07 | 12.2 KB | 452 lines

unit Calc4;
(* Sample Tape Calculator
   For the PC Plus Delphi Tutorial
   Author: Huw Collingbourne

   This program implements a simple general purpose calculator
   with a scrollable list box displaying the caklculations.
   This list can be saved to disk for future reference.

   Defects (which you may like to correct!)
   Currently the calculator...
   - cannot load a saved list (you can use Notepad for this)
   - does no IO checking
   - does not trap errors such as divide by 0 or floating-point overflow
   - has limited editing capabilities in the DisplayEd text edit box


   Note: most of these features have already been implemented in earlier
   programs in the PC Plus Delphi tutorial series. If you want to add them
   to this application, refer to our other samples.

   You may also like to make the program more object orientated by binding the
   'general purpose' routines such as InputError into the form-level class.
   This is discussed in part 4 of the Delphi tutorial.
   *)


interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Menus;

type
  TCalcForm = class(TForm)
    DisplayEd: TEdit;
    Btn8: TButton;
    Btn6: TButton;
    Btn4: TButton;
    Btn2: TButton;
    Btn0: TButton;
    Btn9: TButton;
    Btn7: TButton;
    Btn5: TButton;
    Btn3: TButton;
    Btn1: TButton;
    BtnEquals: TButton;
    BtnDiv: TButton;
    BtnMult: TButton;
    BtnMinus: TButton;
    BtnPlus: TButton;
    BtnDot: TButton;
    ClearBtn: TButton;
    CalcList: TListBox;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    ClearMenuItem: TMenuItem;
    SaveMenuItem: TMenuItem;
    procedure Btn0Click(Sender: TObject);
    procedure Btn1Click(Sender: TObject);
    procedure Btn2Click(Sender: TObject);
    procedure Btn3Click(Sender: TObject);
    procedure Btn4Click(Sender: TObject);
    procedure Btn5Click(Sender: TObject);
    procedure Btn6Click(Sender: TObject);
    procedure Btn7Click(Sender: TObject);
    procedure Btn8Click(Sender: TObject);
    procedure Btn9Click(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure BtnPlusClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnEqualsClick(Sender: TObject);
    procedure BtnDivClick(Sender: TObject);
    procedure BtnMultClick(Sender: TObject);
    procedure BtnMinusClick(Sender: TObject);
    procedure BtnDotClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ClearMenuItemClick(Sender: TObject);
    procedure SaveMenuItemClick(Sender: TObject);
private
    { Private declarations }
    EnterNewFigures: boolean;{ flag if new number is being entered }
    CalcNum : integer;       { keep a check on num of calcs done   }
    { The following Methods aren't event-handlers and are
    not bound to specific visual objects }
    procedure UpdateResult( newOp : char );
    procedure AppendNumber( numCh : char );
    procedure ReInit;

  public
    { Public declarations }

  end;

{ TMemory is a non-visual class which simply stores the previous value
which appeared in the calculator's edit box. Say, for example, we had
a TMemory object called PrevVal, we can now pick and operator, such
as '+' and then enter a new value, called NewVal. When we press the
'=' button (or another operator button such as '+' or '-'), the edit
box can be updated to show the total of PrevVal + NewVal ).    }
TMemory = class(TObject)
  total : real;
  function gettotal : real;
  procedure settotal( r : real );
end;


{ Stores the currently selected operator such as '+' or '-' }
TOperation = class(TObject)
  op : char;
  function getop : char;
  procedure setop( c : char );
end;


var
  CalcForm: TCalcForm;
  LastResult : TMemory;
  LastOp : TOperation;

implementation

{$R *.DFM}

{ Methods of the TMemory class. Set and read the internal variable }
function TMemory.gettotal : real;
begin
 gettotal := total;
end;

procedure TMemory.settotal( r : real );
begin
 total := r;
end;



{ Methods of the TOperation class }
function TOperation.getop : char;
begin
 getop := op;
end;

procedure TOperation.setop( c : char );
begin
 op := c;
end;

{ ------------- general-purpose routines ---------------- }

{ warn user if an erroneous value has been entered - e.g. '1..5' and
allows them to edit the value before continuing }
procedure InputError( TE: TEdit; errcode : integer );
var
   Msg : string;
begin
    if TE.Text = '' Then
       Msg := 'You must enter a value'
    else
       Msg :=  'Invalid character: ' + Copy(TE.Text, errcode, 1);
    MessageDlg(Msg, mtError,
            [mbOk], 0);
    TE.SetFocus;
    TE.SelStart := errcode-1;
    TE.SelLength := 1;
end;

{ checks to see if the value in the edit box is valid. if so,
the value is returned in the variable, realValue and the function
returns True. Otherwise, it returns false }
function CurrentNumberOK( TE: TEdit; var realValue : real ) : boolean;
var
 rv : real;
 errcode : integer;
begin
   Val(TE.Text, rv, errcode);
   if errcode = 0 then
   begin
      realValue := rv;
      CurrentNumberOK := true;
   end
   else
   begin
      InputError(TE, errcode );
      CurrentNumberOK := false;
   end;
end;

{ --- TCacForm methods --- }
procedure TCalcForm.ReInit;
{ Clear memory, clear edit field }
begin
  DisplayEd.Text := '';
  LastResult.settotal(0.0);
  LastOp.setOp('+');
  EnterNewFigures := true;
  CalcNum := 0;
end;

procedure TCalcForm.UpdateResult( newOp : char );
{ When an operator (newOp) is chosen, this method performs the current
calculation and updates the Op field of the LastOp object so that
this is avalable for use in the current calculation }
var
   lastNum : real;
   lastOperator : char;
   newNum : real;
   total : real;
   strLastNum, strNewNum, strTotal : string;
   calcStr : string; { string representation of the entire expression }
   showTotal : boolean;
begin
  newNum := 0.0;
  showTotal := false;

{ The code in this method only executes if the contents of the
  edit field are valid. If an error is encountered, nothing is done.
  This gives the user the chance to correct the error before
  continuing }
  if CurrentNumberOK( DisplayEd, newNum ) then
  begin
      { retrieve the previous value and operator needed for this
      calculation }
    lastNum := LastResult.gettotal;
    lastOperator := LastOp.getop;
    { use a CASE statment to select the appropriate calculation }
    case lastOperator of
      '+': total := lastNum + newNum;
      '-': total := lastNum - newNum;
      '/': total := lastNum / newNum;
      '*': total := lastNum * newNum;
      '=': begin
             total := lastNum;
             ShowTotal := true;
           end;
      else total := lastNum;
    end;
    { Convert the real value, total, to the string value,
      strTotal and display it in the edit box }
    Str(total:2:2, strTotal );
    DisplayEd.Text := strTotal;

    Str(lastNum:2:2, strLastNum);
    Str(newNum:2:2, strNewNum);

    { add the calculation to the list box }
    { we don't need to do anything if '=' was selected, since the
    total is shown automatically. }
    if not ShowTotal then
    begin
    { We don't need to show anything if this is the first number
    that's been entered (calcNum = 0) }
       if calcNum > 0 then
       begin
         calcStr := strLastNum + ' ' + lastOperator + ' '
                        +  strNewNum + ' = ' + strTotal;
         CalcList.Items.Add( calcStr  );  (* XXX *)
         { force the list box to scroll to show newest item at }
         { the last visible line in the box }
         CalcList.TopIndex := CalcList.Items.Count - 1;
       end;
       Inc( CalcNum ) { add 1 to CalcNum }
    end;


    { update the lastOp and lastResult objects,
      ready for the next calculation }
    lastOp.setOp( newOp );
    lastResult.settotal(total);

    { set the EnterNewFigures variable to true. This is used in the
    AppendNumber method }
    EnterNewFigures := true;
  end;
end;

procedure TCalcForm.AppendNumber( numCh : char );
{ If a calculation has just been completed, the EnterNewFigures
  variable is True. So the edit box is cleared to let the user
  start entering a new number. Otherwise, digits are appended
  to the contents of the edit box }
begin
   if EnterNewFigures = true then
   begin
      DisplayEd.Text := '';
      EnterNewFigures := false;
   end;
      DisplayEd.Text := DisplayEd.Text + numCh;
end;

{ the form's event-handling code }
{ Each button sends a number to be added to the edit box }
procedure TCalcForm.Btn0Click(Sender: TObject);
begin
     AppendNumber( '0' );
end;

procedure TCalcForm.Btn1Click(Sender: TObject);
begin
     AppendNumber( '1' );
end;

procedure TCalcForm.Btn2Click(Sender: TObject);
begin
     AppendNumber( '2' );
end;

procedure TCalcForm.Btn3Click(Sender: TObject);
begin
     AppendNumber( '3' );
end;

procedure TCalcForm.Btn4Click(Sender: TObject);
begin
     AppendNumber( '4' );
end;

procedure TCalcForm.Btn5Click(Sender: TObject);
begin
     AppendNumber( '5' );
end;

procedure TCalcForm.Btn6Click(Sender: TObject);
begin
     AppendNumber( '6' );
end;

procedure TCalcForm.Btn7Click(Sender: TObject);
begin
     AppendNumber( '7' );
end;

procedure TCalcForm.Btn8Click(Sender: TObject);
begin
     AppendNumber( '8' );
end;

procedure TCalcForm.Btn9Click(Sender: TObject);
begin
     AppendNumber( '9' );
end;

procedure TCalcForm.ClearBtnClick(Sender: TObject);
begin
  ReInit;
end;

procedure TCalcForm.FormActivate(Sender: TObject);
{ When the calculator is first run, we create the two
objects, LastResult and LastOp and call ReInit to do some
setup tasks }
begin
  LastResult := TMemory.Create;
  LastOp := TOperation.Create;
  ReInit;
end;


procedure TCalcForm.FormClose(Sender: TObject; var Action: TCloseAction);
{ When the calculator is closed, we 'clean up' by destroying the objects
we created in the FormActivate method }
begin
 LastResult.Free;
 LastOp.Free;
end;

{ The operator buttons }

procedure TCalcForm.BtnEqualsClick(Sender: TObject);
begin
     UpdateResult( '=' );
end;

procedure TCalcForm.BtnDivClick(Sender: TObject);
begin
     UpdateResult( '/' );
end;

procedure TCalcForm.BtnMultClick(Sender: TObject);
begin
     UpdateResult( '*' );
end;

procedure TCalcForm.BtnPlusClick(Sender: TObject);
begin
     UpdateResult( '+' );
end;

procedure TCalcForm.BtnMinusClick(Sender: TObject);
begin
     UpdateResult( '-' );
end;

procedure TCalcForm.BtnDotClick(Sender: TObject);
begin
     AppendNumber( '.' );
end;

procedure TCalcForm.FormCreate(Sender: TObject);
{ The KeyPreview property lets the Form examine characters
  even when other controls may have the focus }
begin
  KeyPreview := True;
end;

procedure TCalcForm.FormKeyPress(Sender: TObject; var Key: Char);
{ The form can accept the same characters via keyboard input as
  via the on-screen buttons. The same procedures are called }
begin
  case (Key) of
  '0'..'9', '.' : AppendNumber(Key);
  '+', '-', '/', '*', '=' : UpdateResult(Key);
  end;
end;



procedure TCalcForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
{ Handle 'virtual keys' - specifically Del and Backspace }
begin
  if (Key = VK_Delete) or (Key = VK_Back) then
     DisplayEd.ReadOnly := False; { let the edit box accept these keys }
  end;

procedure TCalcForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
{ make sure the edit box is set back to ReadOnly when the
  current keystroke has been processed
 (see procedure TCalcForm.FormKeyDown) }
begin
  DisplayEd.ReadOnly := True;
end;

procedure TCalcForm.ClearMenuItemClick(Sender: TObject);
begin
  CalcList.Clear;
end;

procedure TCalcForm.SaveMenuItemClick(Sender: TObject);
begin
  CalcList.Items.SaveToFile('CalcList.TXT');
end;

end.